source dialog.tcl

set runningSpeed 0
set isrunning false

proc rec-terminate {n}  {
   exit
}

proc program-started {} {
      .row1.stop configure -state normal
}

proc program-terminated {} {
      .row1.stop configure -state disabled
      .row1.run configure -command run -text " Run "
      after cancel step
}

proc rec-ack-event {e} {
   if {"$e" == "stop" } {
      .row1.step configure -state normal
      .row1.run configure -state normal
   }
}

proc setSpeed {value} {
   global runningSpeed
   set runningSpeed "${value}"

}

proc fileOpen {} {
  set file [tk_getOpenFile -title "Open Pico program"]

  if [file exists $file] {
    set f [open $file r]
    set contents [read $f]
    close $f
  }

  TBevent edit([TBstring $contents])
}

proc fileSave {} {
  set file [tk_getSaveFile -title "Save Pico program"]

  TBevent save([TBstring $file])
}

proc writeFile {file contents} {
  set f [open [TCLstring $file] w]
  puts -nonewline $f [TCLstring $contents]
  close $f
}

proc compile {} {
   TBevent compile
}

proc stop {} {
   global isrunning
   set isrunning false
   after cancel step
   TBevent stop
}


proc pause {} {
   global isrunning
   after cancel step
   set isrunning false
   .row1.run configure -command run -text " Run "
   .row1.step configure -state normal
   .row1.stop configure -state normal
}

proc run {} {
   global isrunning
   set isrunning "yes"
   step
}

proc running {} {
   global runningSpeed
   set tmp [expr 1000 - [expr 9 * $runningSpeed] ]
   after $tmp {step}
}

proc step {} {
   TBevent step
}


proc show-message {m type} {
if {"$type" == "error"} {
   dialog .dialog "Error" "$m" error 0 {OK}
} else {
   dialog .dialog "Info" "$m" info 0 {OK}
}
}

proc start-running {} {
   global isrunning
   if {"$isrunning" == "yes" } {
      .row1.run configure -command pause -text "Pause"
      .row1.step configure -state disabled
      .row1.stop configure -state normal
   }
}

proc stop-running {} {
   global isrunning
    if {"$isrunning" == "yes" } {
     running
   }
}

proc status-line {t} {
   global status-line-str
   set status-line-str "[TCLstring $t]"
}

proc create {} {
   frame .menubar
   frame .row1
   frame .row2
   
   wm title . "Control Panel"

   menubutton .menubar.file -text File -underline 0 -menu .menubar.file.menu
   pack .menubar.file -side left

   menu .menubar.file.menu
   .menubar.file.menu add command -label "Open" -command fileOpen
   .menubar.file.menu add command -label "Save" -command fileSave
   .menubar.file.menu add command -label "Quit" -command exit

   tk_menuBar .menubar .menubar.file


   button .row1.compile -text Compile -command compile

   button .row1.stop -text Stop -command stop -state disabled
   button .row1.run -text " Run " -command run
   button .row1.step -text Step -command step
   
   pack .row1.compile .row1.stop .row1.run .row1.step -side left

   label .row2.label -text "speed"
   scale  .row2.speed -length 7c -orient horizontal -command setSpeed
   pack .row2.label .row2.speed -side left -expand 1 -fill both

   label .status -textvariable status-line-str
   
   pack .menubar .row1 .row2 .status -side top -anchor w  -expand 1 -fill both
}

create

